perm filename PICHAF.SAI[PIX,HPM] blob
sn#426069 filedate 1979-03-14 generic text, type C, neo UTF8
COMMENT ⊗ VALID 00002 PAGES
C REC PAGE DESCRIPTION
C00001 00001
C00002 00002 BEGIN "PICHAF"
C00010 ENDMK
C⊗;
BEGIN "PICHAF"
REQUIRE "VIXHDR.SAI[VIS,HPM]" SOURCE_FILE;
DO
BEGIN "PICBLK"
DEFINE WID=1600, HIG=1200;
INTEGER SAFE ARRAY PIC[0:PIXDIM(HIG,WID+36,1)];
INTEGER I,J,K,L,M,PL,LN; STRING PFL;
INTEGER SAFE ARRAY PC[0:10],BUF[0:20];
INTEGER COUNT,BRCHAR,EOF,CH; BOOLEAN FLAG;
MAKPIX(HIG,WID+36,1,PIC[0]);
PRINT("Picture file:"); PFL←INCHWL; GETPFD(PFL,PC[0]);
CH←GETCHAN; PRSFIL(PFL); EOF←TRUE;
OPEN(CH,DEVPRS,'10,19,0,COUNT,BRCHAR,EOF);
IF ¬EOF THEN LOOKUP(CH,FILPRS,FLAG);
IF FLAG ∨ EOF THEN
BEGIN
RELEASE(CH);
PRINT("Picture file ",PFL," not found",'15&'12);
DONE "PICBLK";
END;
ARRYIN(CH,BUF[0],10);
IF BUF[0]=-1 THEN
BEGIN "new HE format"
ARRYIN(CH,BUF[10],9);
I←'200;
comment in case file is MIT pseudo stanford format, and has no pointers;
FOR K←18,17,16,15,10,9,8,7 DO IF BUF[K]≠0 THEN I←BUF[K];
PC[BYBI]←BUF[1];
PC[LNBY]←BUF[6]-BUF[5]+1;
PC[PCLN]←BUF[4]-BUF[3]+1;
PC[WDBY]←36%PC[BYBI];
PC[LNWD]←BUF[2];
PC[LNBYA]←PC[LNWD]*PC[WDBY];
PC[PCWD]←PC[PCLN]*PC[LNWD];
PC[PCBY]←PC[PCLN]*PC[LNBY];
PC[PCBYA]←PC[PCLN]*PC[LNBYA];
PC[WDBI]←PC[WDBY]*PC[BYBI];
I←(I LAND '777777);
FOR J←19 STEP 1 UNTIL I-1 DO WORDIN(CH); comment skip to first scanline;
END
ELSE
BEGIN comment if old hand eye format;
PC[BYBI]←BUF[2];
PC[LNBY]←BUF[8]-BUF[7]+1;
PC[PCLN]←BUF[6]-BUF[5]+1;
PC[WDBY]←36%PC[BYBI];
PC[LNWD]←(PC[LNBY]+PC[WDBY]-1)%PC[WDBY];
PC[LNBYA]←PC[LNWD]*PC[WDBY];
PC[PCWD]←PC[PCLN]*PC[LNWD];
PC[PCBY]←PC[PCLN]*PC[LNBY];
PC[PCBYA]←PC[PCLN]*PC[LNBYA];
PC[WDBI]←PC[WDBY]*PC[BYBI];
IF PC[BYBI]≤0 ∨ PC[BYBI]>36 ∨ PC[LNBY]≤0 ∨ PC[PCLN]≤0 ∨ BUF[0]<0 THEN
BEGIN
RELEASE(CH);
PRINT(" ",PFL," is not a picture file",'15&'12);
DONE "PICBLK";
END;
END;
BEGIN
PRELOAD_WITH 5.7@-1,6.68@-1,6.68@-1,5.7@-1,4.31@-1,3.32@-1,3.32@-1,4.31@-1,
6.68@-1,9.05@-1,9.05@-1,6.68@-1,3.32@-1,9.47@-2,9.47@-2,3.32@-1,
6.68@-1,9.05@-1,9.05@-1,6.68@-1,3.32@-1,9.47@-2,9.47@-2,3.32@-1,
5.7@-1,6.68@-1,6.68@-1,5.7@-1, 4.31@-1,3.32@-1,3.32@-1,4.31@-1,
4.31@-1,3.32@-1,3.32@-1,4.31@-1,5.7@-1, 6.68@-1,6.68@-1,5.7@-1,
3.32@-1,9.47@-2,9.47@-2,3.32@-1,6.68@-1,9.05@-1,9.05@-1,6.68@-1,
3.32@-1,9.47@-2,9.47@-2,3.32@-1,6.68@-1,9.05@-1,9.05@-1,6.68@-1,
4.31@-1,3.32@-1,3.32@-1,4.31@-1,5.7@-1, 6.68@-1,6.68@-1,5.7@-1;
OWN SAFE REAL ARRAY EGG1[0:63];
PRELOAD_WITH .614, .728, .614, .386, .272, .386,
.728, .956, .728, .272, .044, .272,
.614, .728, .614, .386, .272, .386,
.386, .272, .386, .614, .728, .614,
.272, .044, .272, .728, .956, .728,
.386, .272, .386, .614, .728, .614;
OWN REAL SAFE ARRAY EGG[0:35]; REAL SAFE ARRAY OMLET[0:35];
INTEGER SAFE ARRAY SCNLIN[0:PC[LNWD]-1],BPTS,BPTD[0:WID-1];
REAL SAFE ARRAY ERRS[-1:WID];
PRELOAD_WITH .9375,.1875,.4375,.6875,.75,0,.25,.5,
.8125,.0625,.3125,.5625,.875,.125,.375,.625; OWN REAL SAFE ARRAY H[0:15];
REAL PROCEDURE SGN(REAL X); RETURN(IF X<0 THEN -1 ELSE IF X>0 THEN 1 ELSE 0);
L←POINT(1,MEMORY[PIC[LINTAB]+1],-1);
FOR J←0 STEP 1 UNTIL WID-1 DO
BEGIN
K←J*PC[LNBY]%WID;
BPTS[J]←POINT(PC[BYBI],SCNLIN[K%PC[WDBY]],((K MOD PC[WDBY])+1)*PC[BYBI]-1);
IBP(L); BPTD[J]←L;
END;
FOR I←0 STEP 1 UNTIL 35 DO BEGIN OMLET[I]←2*EGG[I]-1;
comment OMLET[I]←SGN(OMLET[I])*(ABS(OMLET[I]))↑0.1;
IF OMLET[I]<0 THEN OMLET[I]←-2;
OMLET[I]←(OMLET[I]+1)/2; END;
FOR I←0 STEP 1 UNTIL 35 DO
BEGIN IF (I MOD 6)=0 THEN PRINT('15&'12); PRINT(OMLET[I]); END;
PRINT('15&'12);
PL←-1;
FOR I←0 STEP 1 UNTIL HIG-1 DO
BEGIN
INTEGER II,IL;
REAL ERP;
LN←I*PC[PCLN]%HIG;
FOR PL←PL STEP 1 UNTIL LN DO ARRYIN(CH,SCNLIN[0],PC[LNWD]);
II←(I MOD 6)*6; IL←PIC[LNWD]*I; ERP←0;
FOR J←0 STEP 1 UNTIL WID-1 DO
BEGIN
REAL ER;
ER←ERRS[J]+1-LDB(BPTS[J])/PC[BMAX];
IF ER>OMLET[II+(J MOD 6)] THEN
BEGIN DPB(1,BPTD[J]+IL); ER←ER-2; END;
ER←ER*0.25;
ERRS[J]←ER+ERP;
ERRS[J-1]←ERRS[J-1]+ER;
ERRS[J+1]←ERRS[J+1]+ER*1.5;
ERP←ER*0.5;
END;
END;
RELEASE(CH);
PUTPFL(PIC[0],"DSK:FOO.TMP[TMP,HPM]");
VIDXGP(PIC[0],100,(1620-WID)%2,HIG+200);
VIDXGP(PIC[0],100,(1620-WID)%2,HIG+200);
END;
END "PICBLK" UNTIL TRUE;
END "PICHAF";